Background

Responsible Impact (ReAct) is a participatory exercise at the Department of Communication and Psychology that seeks to develop and explore the department’s impact ecosystem. By staff engagement and iterative focus groups, the project collects and assesses annotated real-time data based on registration of impact activities (knowledge dissemination, pathways and linkages) by researchers at the Department of Communication and Psychology at Aalborg University.

By applying a rich and comprehensive impact taxonomy developed by interactive feedback from researchers at the department combined with a user-friendly web-based registration interface, the project aims to capture the diverse impact profiles of the department’s heterogeneous research groups while at the same time allowing researchers to have significant influence on how their impact is represented and communicated.

This websites presents some of the project outcomes as interactive visualizations.

Taxonomy Usage

Column

All

Participation in Person

Participation by Proxy

Inflow

Demographics

Row

Participant Positions

Testi 1

Row

Relative Contribution Per Category by Position

Testi 3

Cases

Row

Svend Brinkman

Legend

Rikke Magnusen

Legend

Row

Rikke Kristine Nielsen

Legend

Music Therapy

Legend

Analysis

Column

Heatmap

Activity Diversity Value

And so on

---
title: "ReAct // Data Analytics Dashboard"
output: 
  flexdashboard::flex_dashboard:
    theme: bootstrap
    vertical_layout: scroll 
    social: menu
    source: embed
---

```{r setup, include=FALSE,echo = FALSE,warning=FALSE}
library(flexdashboard)
require(tidyverse)
require(forcats)
require(tidytext)
require(silgelib)
require(ggthemes)
require(hrbrthemes)
require(patchwork)
require(scales)
require(plotly)
require(d3heatmap)
require(RColorBrewer)
require(sunburstR)

firstup <- function(x) {
  substr(x, 1, 1) <- toupper(substr(x, 1, 1))
  x
}

all_data_final <- read_csv("201201_all_data_final.csv")
user_ids_final <- read_csv("user_ids_final.csv")
all_data_final%>%
  pivot_longer(cols = -user_name, 
      names_to = 'category',values_to='count')%>%
        left_join(user_ids_final%>%
                        select(name,position),
                            by=c('user_name'='name'))%>%
            mutate(count=ifelse(is.na(count),
                                0,count))->all_data_final_long

all_data_final_long%>%
  mutate(category = str_replace(category,pattern = '_',replacement = ' - '))%>%
    separate(category,into = c('category','B'),sep = ' - ')%>%
      mutate(B = firstup(B))%>%
        unite(col = category,category,B,sep = ' - ')%>%
          mutate(category = firstup(category))->all_data_final_long
    

#can only be loaded here after all_data_final_long is done
source('helpers_new.R')

all_data_final_long%>%
  mutate(count=ifelse(count>0,1,0))%>%
      group_by(category)%>%
        summarise(category_total=(sum(count)/n_distinct(user_name)))%>%
          mutate(top_category=case_when(
            category%in%ParticipationInPerson ~'ParticipationInPerson',
            category%in%ParticipationByProxy ~'ParticipationByProxy',
            category%in%Inflow ~'Inflow'))%>%
          mutate(top_category=factor(top_category,levels=c('ParticipationInPerson',
                                             'ParticipationByProxy','Inflow')),
                 category=as.factor(category))%>%
            mutate(category= reorder_within(category,
                                category_total,top_category))->taxonomy_plots


```

Background {data-icon="fa-book-open"} 
================================
[Responsible Impact (ReAct) is a participatory exercise at the Department of Communication and Psychology](https://www.communication.aau.dk/research/Research+Projects/react/) that seeks to develop and explore the department's impact ecosystem. By staff engagement and iterative focus groups, the project collects and assesses annotated real-time data based on registration of impact activities (knowledge dissemination, pathways and linkages) by researchers at the Department of Communication and Psychology at Aalborg University. 

By applying a rich and comprehensive impact taxonomy developed by interactive feedback from researchers at the department combined with a user-friendly web-based registration interface, the project aims to capture the diverse impact profiles of the department’s heterogeneous research groups while at the same time allowing researchers to have significant influence on how their impact is represented and communicated.

This websites presents some of the project outcomes as interactive visualizations.


Taxonomy Usage {data-icon="fa-bars"} 
================================
Column {.tabset}
-----------------------------------------------------------------------


### All {data-height=1200} 

```{r}

taxonomy_plots%>%ggplot(mapping=aes(x=category,y=category_total,
                                            fill=top_category))+
                              geom_col(aes(text=paste('Percentage:',
                                        round(category_total*100,2))))+coord_flip()+
                                scale_fill_manual(values = cols)+
                                  scale_y_continuous(labels = percent)+
                                      scale_x_reordered()+
                                           theme_minimal()+
                  labs(x='',y='Percentage of Participants',
                    fill='',title='')+
                theme(axis.text.y = element_text(size=7))->taxonomy_usage_all

ggplotly(taxonomy_usage_all,tooltip = c('text'))%>%
  layout(legend = list(orientation = "h",x = 0, y = -0.1))

```

### Participation in Person
```{r}
taxonomy_plots%>%filter(str_detect(top_category,'Person'))%>%
  ggplot(mapping=aes(x=category,y=category_total,
                                            fill=top_category))+
                              geom_col()+coord_flip()+
                                scale_fill_manual(values = cols)+
                                  scale_y_continuous(labels = percent)+
                                      scale_x_reordered()+
                                           theme_minimal()+
                  labs(x='',y='Percentage of Participants',
                    fill='',title='')+
                theme(axis.text.y = element_text(size=7))->taxonomy_usage_person

ggplotly(taxonomy_usage_person)
```
### Participation by Proxy 
```{r}
taxonomy_plots%>%filter(str_detect(top_category,'Proxy'))%>%
  ggplot(mapping=aes(x=category,
                     y=category_total,
                            fill=top_category))+
                              geom_col()+coord_flip()+
                                scale_fill_manual(values = cols)+
                                  scale_y_continuous(labels = percent)+
                                      scale_x_reordered()+
                                           theme_minimal()+
                  labs(x='',y='Percentage of Participants',
                    fill='',title='')+
                theme(axis.text.y = element_text(size=7))->taxonomy_usage_proxy

ggplotly(taxonomy_usage_proxy)
```
### Inflow 
```{r}
taxonomy_plots%>%filter(str_detect(top_category,'Inflow'))%>%
  ggplot(mapping=aes(x=category,y=category_total,
                                            fill=top_category))+
                              geom_col()+coord_flip()+
                                scale_fill_manual(values = cols)+
                                  scale_y_continuous(labels = percent)+
                                      scale_x_reordered()+
                                           theme_minimal()+
                  labs(x='',y='Percentage of Participants',
                    fill='',title='')+
                theme(axis.text.y = element_text(size=7))->taxonomy_usage_inflow

ggplotly(taxonomy_usage_inflow)
```
### Inputs {.sidebar}
-------------------------------------
Bla bla bla 




Demographics {data-icon="fa-users"} 
=====================================  

Row
-------------------------------------
   
### Participant Positions
```{r}
user_ids_final%>%
          group_by(position)%>%
              count()%>%ungroup%>%
                mutate(total=sum(n),percentage=n/total)%>%
  ggplot(aes(x=reorder(position,percentage),y=percentage))+
  geom_col(aes(text=paste('Percentage:',
                          round(percentage*100,2),'\nCount:',n)))+
          coord_flip()+
            scale_y_continuous(labels = percent)+
               labs(x='',y='Percentage of Participants',
                    fill='',title='')+theme_minimal()->demo_position

ggplotly(demo_position,tooltip = c('text'))
```

### Testi 1

```{r}
```

Row
---------------------------------------

### Relative Contribution Per Category by Position
```{r}
all_data_final_long%>%
  mutate(count=ifelse(count>0,1,0))%>%
          mutate(top_category=case_when(
            category%in%ParticipationInPerson ~'ParticipationInPerson',
            category%in%ParticipationByProxy ~'ParticipationByProxy',
            category%in%Inflow ~'Inflow'))%>%
          mutate(top_category=factor(top_category,levels=c('ParticipationInPerson',
                                             'ParticipationByProxy','Inflow')),
                 category=as.factor(category))%>%
                    group_by(position,top_category)%>%
                      summarise(total_count=sum(count))%>%
  ggplot(aes(x=reorder(position,total_count),y=total_count,fill=top_category))+
           geom_col()+coord_flip()+ 
            scale_fill_manual(values = cols)+theme_minimal()+
                labs(x='Position',
                  y='Total Contribution Per Top Category',fill='')->position_top_category_count

ggplotly(position_top_category_count)
```
### Testi 3

Cases {data-icon="fa-users"} 
=====================================  
```{r}
all_data_final_long%>%mutate(top_category=case_when(
  category%in%ParticipationInPerson ~'ParticipationInPerson',
  category%in%ParticipationByProxy ~'ParticipationByProxy',
  category%in%Inflow ~'Inflow'))%>%
  mutate(top_category=factor(top_category,levels=c('ParticipationInPerson',
                                                   'ParticipationByProxy','Inflow')))%>%
  mutate(category = str_remove(category,'Inflow - '))%>%
  mutate(helper = str_remove(category,' - '))%>%
  mutate(category = sub(x = category,pattern = ' .*',replacement = ''))%>%
  mutate(category = ifelse(category == helper,'Reference',category))%>%
  mutate(category=as.factor(category))%>%
  unite('sunburst_combo',c(top_category,category,helper),sep='-')%>%
      mutate(sunburst_combo = str_remove_all(sunburst_combo,pattern =' '))%>%
        select(user_name,V1=sunburst_combo,V2=count)->sunburst_data

tibble(
colors=c('blue','red','darkgreen',
          rep('#5B5BFF',8),
          rep('#B6B6FF',42),
          rep('#FF5B5B',5),
          rep('#FFB6B6',33),
          rep('#008300',4),
          rep('#C5FFC5',17)),
labels=c(c("ParticipationInPerson","ParticipationByProxy","Inflow"),
          sunburst_data%>%
            separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
            filter(layer1=='ParticipationInPerson')%>%pull(layer2)%>%unique,
          sunburst_data%>%
            separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
            filter(layer1=='ParticipationInPerson')%>%pull(layer3)%>%unique,
          sunburst_data%>%
            separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
            filter(layer1=='ParticipationByProxy')%>%pull(layer2)%>%unique,
          sunburst_data%>%
            separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
            filter(layer1=='ParticipationByProxy')%>%pull(layer3)%>%unique,
          sunburst_data%>%
            separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
            filter(layer1=='Inflow')%>%pull(layer2)%>%unique,
          sunburst_data%>%
            separate(V1,c('layer1','layer2','layer3'),sep = '-')%>%
            filter(layer1=='Inflow')%>%pull(layer3)%>%unique))->color_tibble

```

Row
-------------------------------------

### Svend Brinkman
```{r}
sunburst_data%>%
    filter(user_name=='Brinkmann, Svend')%>%
      #mutate(V2=ifelse(V2>0,1,0))%>%
       select(-user_name)%>%
        sunburst(colors = list(range=color_tibble$colors,
                                domain=color_tibble$labels),legend=FALSE)
```
### Rikke Magnusen
```{r}
sunburst_data%>%
    filter(user_name=='Magnussen, Rikke')%>%
      #mutate(V2=ifelse(V2>0,1,0))%>%
       select(-user_name)%>%
        sunburst(colors = list(range=color_tibble$colors,
                                domain=color_tibble$labels),legend=FALSE)
```

Row
-------------------------------------

### Rikke Kristine Nielsen
```{r}
sunburst_data%>%
    filter(user_name=='Nielsen, Rikke Kristine')%>%
      #mutate(V2=ifelse(V2>0,1,0))%>%
       select(-user_name)%>%
        sunburst(colors = list(range=color_tibble$colors,
                                domain=color_tibble$labels),legend=FALSE)
```


### Music Therapy
```{r}
sunburst_data%>%
    filter(user_name=='Ridder, Hanne Mette Ochsner')%>%
      #mutate(V2=ifelse(V2>0,1,0))%>%
       select(-user_name)%>%
        sunburst(colors = list(range=color_tibble$colors,
                                domain=color_tibble$labels),legend=FALSE)
```


Analysis {data-icon="fa-cog"} 
================================
Column {.tabset}
-----------------------------------------------------------------------


### Heatmap {data-height=1200} 

```{r}
top_5_each<-c('TeachingActivity - HigherEducation',
                          'FieldActivities - Meeting',
                              'AcademicEvent - Meeting',
                                  'AcademicEvent - Seminar',
                                    'AcademicEvent - Conference',
                            'AcademicProduct - Paper',
                        'AcademicProduct - Chapter',
                            'MediaProduct - ArticleJournalism',
              'AcademicProduct - Manuscript','AcademicProduct - Abstract',
              'Inflow - PopularMention','Inflow - PopularCitation',
              'Request - Collaboration','Request - Advice','Request - Text')

all_data_final_long%>%filter(category%in%top_5_each)%>%
                pivot_wider(names_from=category,values_from = count)%>%
          select(-position)%>%column_to_rownames('user_name')->data_for_heatmap

d3heatmap(data_for_heatmap,
              scale = 'column',
                  col = 'Blues',
                  na.color = 'Darkblue',
                    dendrogram = 'row',
                        k_row=4,
                          cexCol = 0.8,cexRow = 0.8,
                            height =900,width = 700,
                              labColSize = 200,labRowSize = 200)

```

### Activity Diversity Value
```{r}
#How diverse are participants in their activities
#i.e. among all possible 

all_data_final_long%>%mutate(count = ifelse(count == 0,0,1))%>%
                        group_by(user_name,position)%>%
                            summarise(count_activities = sum(count),
                                      total_cats=n(),
                                      adv = count_activities/total_cats)%>%
                          mutate(position = firstup(position))%>%
    ggplot(mapping = aes(x=position,y=adv))+
        geom_violin(aes(color = position, 
                            fill = position),alpha=0.6)+
          geom_jitter(width = 0.2,
              aes(color=position,fill=position,
                text=paste('Participant: ',
                      user_name,'\nActivity Diversity Valye: ',adv)))+
          theme_minimal()+
            labs(y='Activity Diversity Value',
                    x='',fill='',color='')->adv_plot

ggplotly(adv_plot,tooltip = c('text'))
```

### And so on


### Inputs {.sidebar}
-------------------------------------
Bla bla bla